home *** CD-ROM | disk | FTP | other *** search
Wrap
/* $VER: LHA-LZX REPACK V2.04b Updated by Christer Bjarnemo (1995/12/17) */ TempDir = 'HD1:TRASHCAN/' Mode = '3' Priority = -1 VirtualDisk = 'FM0:' /*************************************************/ /* I recommend you leave it alone from here. :-) */ /*************************************************/ Arg Dir arg1 arg2 arg3 arg4 forcelzx = 0 LZXStore = TempDir TempDir = TempDir'_LZX_TEMP/' If ~EXISTS(TempDir) then address COMMAND 'makedir 'left(TempDir,length(TempDir)-1) PATTERN = '.LZH|.LHA|.ZIP|.ARJ|.ARC|.ZOO|.GZ|.Z' say say 'LHA-LZX repacker 2.04b updated by Christer Bjarnemo 1995-12-17.' say 'Original program by Mat Bettinson of the Plot Hatching Factory.' say if upper(arg1) = 'FORCELZX' | upper(arg2)='FORCELZX' | upper(arg3)='FORCELZX' | upper(arg4)='FORCELZX' then ForceLZX = 1 if upper(arg1) = 'KEEPOLD' | upper(arg2)='KEEPOLD' | upper(arg3)='KEEPOLD' | upper(arg4)='KEEPOLD' then KEEPOLD = 'YES' if upper(arg1) = 'ONLYLHA' | upper(arg2)='ONLYLHA' | upper(arg3)='ONLYLHA' | upper(arg4)='ONLYLHA' then PATTERN = '.LZH|.LHA' if upper(arg1) = 'DMS' | upper(arg2)='DMS' | upper(arg3)='DMS' | upper(arg4)='DMS' then PATTERN = PATTERN'|.DMS' If Dir = '?' | Dir = '/?' | Dir = '-?' | Dir = '' then signal Usage If dir = '22'x'22'x then do dir = '22'x'22'x address command 'assign CDIR: 'dir dir = 'CDIR:' end If ~EXISTS(Dir) then signal Usage say Call Pragma('S',50000) If right(Dir,1) ~= '/' & right(Dir,1) ~= ':' then Dir = Dir'/' Address COMMAND 'Assign REPACK: 'Tempdir Call Pragma('D','REPACK:') Address COMMAND 'List 'Dir' PAT #?('PATTERN') FILES LFORMAT "%n %c" >t:LHA-LZX.temp' Call Open(list,'t:LHA-LZX.temp','R') BSave = 0 DO forever Line = ReadLN(list) File = strip(word(line,1)) ; Comment = strip(word(line,2)) ; Comment = Strip(Comment,'B','"') IF EOF(list) then break NewFile = Left(File,Length(file)-length(ext(file)))'LZX' say 'Converting file: 'File Address COMMAND 'Delete >NIL: REPACK:#? ALL FORCE' Call Open(ts,Dir||file) ; Lhasize = Seek(ts,0,'E') ; Call Close(ts) /* Now we are going to extract the archive */ if ext(file)='LHA' then Address COMMAND 'LHA -a -F -M -P'Priority' x 'Dir||File' #? REPACK:' if ext(file)='LZH' then Address COMMAND 'LHA -a -F -M -P'Priority' x 'Dir||File' #? REPACK:' if ext(file)='ZIP' then Address COMMAND 'UnZip 'Dir||File' -d REPACK:' if ext(file)='DMS' then do Address command 'format >NIL: <NIL: drive 'VirtualDisk' name Empty quick noicons' Address COMMAND 'unDMS <NIL: write 'Dir||File' to 'VirtualDisk' NOPAUSE NOTEXT' Address COMMAND 'Copy >NIL: FM0:#? all to REPACK:' end if ext(file)='ARJ' then Address COMMAND 'UnARJ x 'Dir||File' REPACK:' if ext(file)='ARC' then do Pragma('D','REPACK:') Address COMMAND 'ARC x 'Dir||File end if ext(file)='ZOO' then do Pragma('D','REPACK:') Address COMMAND 'ZOO eq/ 'Dir||File end if ext(file)='GZ' then Address COMMAND 'GZIP 'Dir||left(file,length(file)-1-length(ext(file)))' -cdN >REPACK:'left(file,length(file)-1-length(ext(file))) if ext(file)='Z' then Address COMMAND 'uncompress 'Dir||left(file,length(file)-1-length(ext(file)))' -c >REPACK:'left(file,length(file)-1-length(ext(file))) if RC ~= 0 then do say '' say 'WARNING! Something went wrong while unpacking 'file'.' say 'The 'ext(file)' file could be corrupt, or (hopefully) there wasnt enough' say 'space left on your hd/ramdisk.' call writech(stdout,'Do you want to continue? (some files might be LOST forever) (y/N ) ') parse pull choice if upper(choice) ~= 'Y' then do exit(20) end end Address COMMAND 'LZX -r -e -M5000 -'Mode' -P'Priority' -F a 'LZXStore||NewFile' REPACK:#?' if RC ~= 0 then do fel = 1 say '' say 'WARNING! Something went wrong while packing 'LZXStore||newfile'.' call writech(stdout,'Do you want to continue? (keeps the 'ext(file)' file) (y/N ) ') parse pull choice if upper(choice) ~= 'Y' then do Address COMMAND 'Delete >NIL: 'LZXStore||newfile say 'The original file 'file' is untouched :-)' exit(20) end end if fel ~= 1 then do Call Open(ts,LZXStore||NewFile) ; Lzxsize = Seek(ts,0,'E') ; Call Close(ts) Diff = Lhasize - Lzxsize If Diff > 0 | ForceLZX then DO if KEEPOLD ~= 'YES' then Address COMMAND 'Delete >NIL: 'Dir||File If Comment ~= '' then Address COMMAND 'Filenote 'LZXStore||NewFile' "'Comment'"' Address COMMAND 'Copy 'LZXStore||newfile' to 'dir if RC ~= 0 then do say '' say 'WARNING! Something went wrong while copying 'newfile' to 'dir'.' call writech(stdout,'Do you want to continue? (the archive will be LOST forever) (y/N ) ') parse pull choice if upper(choice) ~= 'Y' then do say 'You should copy the file 'LZXStore||newfile' to a SAFE place.' exit(20) end end Address COMMAND 'Delete >NIL: 'LZXStore||newfile say '* 'Diff' bytes saved on this archive!' ; say END ELSE DO Address COMMAND 'Delete >NIL: 'LZXStore||Newfile say '* 'ext(file)' file 'ABS(Diff)' bytes larger than LZX. Keeping 'ext(file)'...' ; say Diff = 0 END BSave = BSave + Diff end else say '* Keeping 'ext(file)'...' end Call Close(list) Address COMMAND 'Delete >NIL: REPACK:#? ALL FORCE' Address COMMAND 'Assign REPACK: REMOVE' Address COMMAND 'Assign CDIR: REMOVE' say say ' *** LHA-LZX Repacker finished. 'Bsave' bytes saved in this dir. ***' say EXIT Usage: say 'Usage: LHA2LZX <Directory> [options]' say say ' ForceLZX Allways keep the LZX file even if the LHA file is smaller' say ' KeepOLD Keep both LhA/ZIP and the LZX file' say ' OnlyLHA Only repack LHA files' say ' DMS Repack DMS archives' say say 'HINT: Replace <directory> with "" if you want to repack current dir.' say EXIT ext: procedure arg filename do i=1 to length(filename) if upper(substr(filename,length(filename)-i,1)) = '.' then break end extension = upper(right(filename,i)) return(extension)